class: inverse,left, middle background-image: url(data:image/png;base64,#background.png) background-size: cover <img src="data:image/png;base64,#LOGO_DIPLOMADO.png" width="500px"/> ##Módulo 2: Estadística espacial y geoestadística ### Interpolación Kriging de regresión Javiera Aguayo T.<br> javiera.aguayo@pucv.cl<br> .large[<b><a href="https://www.pucv.cl/uuaa/site/edic/base/port/labgrs.html">LabGRS</a> | Octubre 2023</b>] <br> --- class: center,middle background-image: url(data:image/png;base64,#labgrs_logo.png) background-size: 35% --- ##Contenidos .pull-left[ 1) ¿Podemos interpolar mas de una variable a la vez? 2) Interpolación de Kriging por regresión 3) Contexto del Ejercicio 4) Ejercicio Interpolación de Kriging por Regresión 5) Comparación de las Interpolaciones 6) Comparación de las Validaciones ] .pull-right[ <right><img src="data:image/png;base64,#https://ucsbcarpentry.github.io/CustomDC-R/fig/r_rollercoaster.png" width="500px"/></right> ] --- ## ¿Podemos interpolar mas de una variable a la vez? .pull-left[ - En la clase anterior se estudió el método de interpolación por __Kriging Ordinario__, a partir del cual se obtuvo un predicción de un variable en sitios de un lugar determinado, donde no existen observaciones. - Pero que pasa si en el mismo sitio existen otras variables ( __*variables secundarias, auxiliares o explicativas*__ ), que pueden impactar al resultado obtenido por la interpolación por Kriging Ordinario. ] .pull-right[ <center><img src="data:image/png;base64,#maps_capas_ESRI.png" width="400px"/></center> Harder C y Clint Brown C., 2017 ] --- ## Interpolación por Kriging de regresión - El método conocido como __Kriging de regresión__ (Hengl, Heuvelink y Rossiter, 2007) permite predecir o interpolar los valores de una variable en sitios no muestreados con observaciones utilizando capas de datos secundarios que actúan como variables predictoras. - Este método de interpolación __modela la relación entre el objetivo y las variables ambientales auxiliares en las ubicaciones de muestra__, y lo aplica a ubicaciones no muestreadas usando el valor conocido de las variables auxiliares en esas ubicaciones (Hengl, Heuvelink, and Rossiter 2007). - Algunos de los predictores ambientales axiliares o variables secundarias, que son comunmente utilizadas son parametros de la superficie terrestre( McKenzie y Ryan, 1999 ), tales como: - Indices a partir de imágenes satelitales - Mapas Geológicos - Mapas de suelo - Mapas de Clasificación de usos de suelo. --- ## Ejercicio Interpolación de Kriging por Regresión **Contexto del ejercicio** .pull-left[ A continuación interpolaremos valores de concentración de Mercurio (Hg) en el suelo del Valle Geul, Bélgica. La hipotesis del análisis es que las mayores concentraciones estarían asociadas espacialmente a la “cercanía al río” desde donde vinieron los contaminantes y también estarían asociados a “zonas de menor altitud”. **Variable principal**: - Puntos de concentración de Mercurio (Hg) **Variables secundarias**: - Raster de Distancia - Modelo de Elevación Digital ] .pull-right[ <center><img src="data:image/png;base64,#Mapa_valle_Geul.jpg" width="400px"/></center> .footnote[Moor J. y Verstraete G., 2008] ] --- ##Ejercicio Interpolación de Kriging por Regresión ###Apertura y visualización de los datos .pull-left[ ```r datos_Hg <- read_csv("datos_mercurio.csv") ptos_Hg <- vect(datos_Hg, c("x", "y"), crs = "epsg:28992") poli_geul <- vect("mask_valle_geul.shp") ``` ] .pull-right[ <img src="data:image/png;base64,#DIPGEOPR_02_8_files/figure-html/unnamed-chunk-3-1.png" width="100%" /> ] --- ###Estimación de regresión ```r regresion <- lm(Hg~elev+dist_rio, data = datos_Hg) summary(regresion) ``` ``` ## ## Call: ## lm(formula = Hg ~ elev + dist_rio, data = datos_Hg) ## ## Residuals: ## Min 1Q Median 3Q Max ## -240.29 -121.71 15.13 86.58 366.06 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) -1200.2155 866.1916 -1.386 0.1702 ## elev 17.7526 9.9839 1.778 0.0797 . ## dist_rio -1.0568 0.1911 -5.531 5e-07 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 139.4 on 71 degrees of freedom ## Multiple R-squared: 0.3042, Adjusted R-squared: 0.2846 ## F-statistic: 15.52 on 2 and 71 DF, p-value: 2.559e-06 ``` --- ###Agregación a de residuales a la datos iniciales ```r #Agregrar los residuales del modelo de regresión a la tabla de datos datos_Hg$residuales = regresion$residuals str(datos_Hg) ``` ``` ## spc_tbl_ [74 × 6] (S3: spec_tbl_df/tbl_df/tbl/data.frame) ## $ x : num [1:74] 190293 190325 190325 190355 190370 ... ## $ y : num [1:74] 315470 315480 315405 315510 315460 ... ## $ Hg : num [1:74] 55 61 154 159 170 87 229 57 271 134 ... ## $ elev : num [1:74] 85.8 85.1 85.5 84.8 85 85.7 84.8 89.1 85.9 84.8 ... ## $ dist_rio : num [1:74] 295 263 271 234 219 ... ## $ residuales: Named num [1:74] 44 28.3 123.1 100.8 93.1 ... ## ..- attr(*, "names")= chr [1:74] "1" "2" "3" "4" ... ## - attr(*, "spec")= ## .. cols( ## .. x = col_double(), ## .. y = col_double(), ## .. Hg = col_double(), ## .. elev = col_double(), ## .. dist_rio = col_double() ## .. ) ## - attr(*, "problems")=<externalptr> ``` --- ###Variograma experimental de los residuales ```r v <- gstat(formula = residuales~1, locations = ~x+y, data = datos_Hg) v_exp <- variogram(v, boundaries= c(25, 50, 100, 200, 350, 600, 900)) plot(v_exp, plot.numbers = TRUE) ``` <img src="data:image/png;base64,#DIPGEOPR_02_8_files/figure-html/unnamed-chunk-6-1.png" width="100%" /> --- ###Ajuste del variograma experimental de los residuales ```r ## Ajuste del variograma de los residuales parametros_variograma <- vgm(nugget = 2500, psill = 20000, range = 600, model = "Ste") v_ajustado <- fit.variogram(v_exp, parametros_variograma, fit.method = 6) plot(v_ajustado, 800) ``` <img src="data:image/png;base64,#DIPGEOPR_02_8_files/figure-html/unnamed-chunk-7-1.png" width="100%" /> --- ###Creación de ráster sin inforación ```r raster_vacio <- rast(extent = ext(dem_geul), #Extensión del poligono de entrada resolution = 25, #Resolución espacial crs = "epsg:28992") #Sistema de proyección raster_poli <- rasterize(poli_geul, raster_vacio) plot(raster_poli, legend = F) ``` <img src="data:image/png;base64,#DIPGEOPR_02_8_files/figure-html/unnamed-chunk-9-1.png" width="100%" /> --- ###Interpolación por Kriging Ordinario de los residuales ```r ## Interpolación de residuales por Kriging Ordinario Kriging_ordinario <- gstat(formula = residuales~1, locations = ~x+y, data = datos_Hg, model = v_ajustado) interpolacion_ko <- interpolate(raster_poli, Kriging_ordinario, xyNames = c("x", "y")) %>% mask(raster_poli) ``` ``` ## [using ordinary kriging] ## [using ordinary kriging] ``` ```r prediccion_residuales_Hg <-interpolacion_ko$var1.pred ``` --- ###Kriging Ordinario de los residuales ```r plot(interpolacion_ko) ``` <img src="data:image/png;base64,#DIPGEOPR_02_8_files/figure-html/unnamed-chunk-11-1.png" width="100%" /> --- ###Aplicación del Modelo de Regresión ```r modelo_regresion <- -1200.2155+17.7526*dem_geul-1.0568*distancia_rio #regresion lineal bivariada plot(modelo_regresion) ``` <img src="data:image/png;base64,#DIPGEOPR_02_8_files/figure-html/unnamed-chunk-12-1.png" width="100%" /> --- ###Resultado del Kriging por Regresión Se realiza un geoproceso de álgebre de datos, entre el rasterde intepolación del kriging ordinario de los residuales y el raster que contiene la regresión lineal dual. <center><img src="data:image/png;base64,#Resultado_Kriging_Regresion.png" width="800px"/></center> --- ## Comparación de las Interpolaciones <center><img src="data:image/png;base64,#Comparacion_01.png" width="700px"/></center> --- ## Comparación de las Validaciones <center><img src="data:image/png;base64,#Comparacion_02.png" width="700px"/></center> --- ### Bibliografía 2017.Hengl T., Heuvelink G., Rossiter D.About regression-kriging: From equations to case studies. Computers & Geosciences. https://www.sciencedirect.com/science/article/pii/S0098300407001008?via%3Dihub 2017.Hader C.y Brown C. The ArcGIS Book. Second Edition. 1999.Mc.enzie N., Ryan P.Spatial prediction of soil properties using environmental correlation. Geoderma. 2022.Rubén Fernández Casal y Tomás Cotos Yáñez. Estadística Espacial con R. https://rubenfcasal.github.io/estadistica_espacial/index.html Mariano Córdoba, Pablo Paccioretti, Franca Giannini Kurina, Cecilia Bruno, Mónica Balzarini. Guía para el análisis de datos espaciales. Aplicaciones en agricultura. https://www.agro.unc.edu.ar/~estadisticaaplicada/GpADEAA/ --- class: inverse middle 